home *** CD-ROM | disk | FTP | other *** search
/ HamCall (October 1991) / HamCall (Whitehall Publishing)(1991).bin / database / findex / findex.bas < prev    next >
BASIC Source File  |  1980-01-01  |  33KB  |  465 lines
  1. 1 GOSUB 62000:GOTO 10000
  2. 100 ON ERROR GOTO 0:GOSUB 20200
  3. 110 PRINT"Enter a search command...  Separate Multi-Word commands with AND, OR, or NOT":GOSUB 20100
  4. 130 M=0:LOCATE 7,1:PRINT "Command Options:":PRINT "DEFO  Define Output Format":PRINT"SORT  Sort File":PRINT"NNAM  New Filename":PRINT"RST   Restart Database":PRINT"ADD   Add New Record"
  5. 140 PRINT "TLOD  Disk Token Load":PRINT"TOKN  Edit Token File":PRINT"MORE  More Commands"
  6. 150 LOCATE 17,1:PRINT "For Group Functions, append the search command with:":PRINT"\D GROUP DELETE    \T GROUP TALLY    \W GROUP WRITE(DISK)":PRINT"\S GROUP STATS     \P GROUP PRINT    \O GROUP SERIAL OUT":PRINT
  7. 155 IF Z=1 THEN LOCATE 22,1,1:PRINT "Use of -AND- and - * - is redundant. Please redo...":Z=0
  8. 156 IF PEEK(100)=255 THEN GOSUB 7107:PRINT"Too Full to Sort!":POKE 100,0
  9. 160 FFLG=0:SOK=0:LOCATE 23,1,1:LINE INPUT"Command? ",X$:GOSUB 7107:IF X$="" OR LEN(X$)>64 THEN 160:ELSE LODIS=1:DFLG=0:TEMP$=""
  10. 165 FUNC$="":IF LEFT$(RIGHT$(X$,2),1)="\" THEN FUNC$=CHR$(ASC(RIGHT$(X$,1)) AND 223):X$=LEFT$(X$,LEN(X$)-2)
  11. 166 IF Y$=">" THEN X$=">*":Y$=X$
  12. 167 IF LEFT$(Y$,1)=">" THEN U$=RIGHT$(X$,LEN(X$)-1)+CHR$(252):GOTO 180
  13. 168 IF FFLG=0 AND (LEN(X$)=3 OR LEN(X$)=4) THEN 9000
  14. 170 GOSUB 11000:U$=X$+CHR$(252)
  15. 180 FOR X=1 TO 7
  16. 190 Y=INSTR(U$,TOK$(X)):IF Y=0 THEN NEXT X:ELSE U$=MID$(U$,1,Y-1)+CHR$(NUM(X))+MID$(U$,Y+LEN(TOK$(X))):GOTO 190
  17. 200 J=0:TOT=0:GOSUB 7120:GOSUB 7300:IF Z=1 AND Y$<>X$ THEN 100:ELSE IF Z=1 THEN 320
  18. 235 RNO=0
  19. 240 IF LEFT$(Y$,1)<>">" THEN POKE 16,PEEK(0):POKE 17,PEEK(1):POKE 18,19:POKE 19,0:POKE 32,FNB(P(DBLK)-19):POKE 33,FNC(P(DBLK)-19):POKE 34,PEEK(32):POKE 35,PEEK(33):POKE F,7:CALL G:B=0
  20. 250 DEF SEG:N2=PEEK(1+VARPTR(U$))+256*PEEK(2+VARPTR(U$)):DEF SEG=MC:POKE 12,FNB(BAS):POKE 13,FNC(BAS):POKE 14,FNB(N2):POKE 15,FNC(N2):POKE 30,PEEK(14):POKE 31,PEEK(15)
  21. 260 POKE F,3:CALL G:IF FNA(32)>=P(DBLK)-19 OR FNA(22)=P(DBLK)-1 THEN ON DBLK GOTO 270,272:ELSE 275
  22. 270 GOSUB 11050:IF LEFT$(Y$,1)=">" THEN Y$=RIGHT$(Y$,LEN(Y$)-1)
  23. 271 GOTO 240
  24. 272 POKE 22,0:POKE 23,0:B=DS2
  25. 275 IF FUNC$="S" THEN 8500:ELSE FOR X=1 TO 19:E$(X)=SPACE$(80)
  26. 280 IF X=1 OR PEEK(42)=1 THEN GOSUB 7200:POKE F,4:CALL G:E$(X)=T$
  27. 290 NEXT X
  28. 292 IF Y$<>"B" THEN J=J-(FNA(22)<>0):ON ERROR GOTO 810:TOT=TOT+VAL(E$(T))
  29. 295 ON ERROR GOTO 0
  30. 300 IF FUNC$<>"" THEN 8500
  31. 320 POKE F,5:CALL G
  32. 330 IF FFLG THEN RETURN
  33. 340 IF FUNC$="S" THEN N=FNA(4)-2:Y=FNA(81)-2:PRINT:PRINT"Search Stats:";Y;:IF PEEK(110)=1 AND OB=0 THEN PRINT" of";N;"records":ELSE PRINT " records"
  34. 505 FUNC$="":IF DFLG=0 THEN DFLG=1:LOCATE 20,1,1:PRINT STRING$(80,205);:ON LODIS GOSUB 2000,2040,2050
  35. 550 POKE 105,23:GOSUB 7110:LOCATE 23,1,0:IF Z=1 THEN PRINT "Use of <AND> and <*> in- ";X$;" is redundant. Please redo.":GOTO 575
  36. 560 PRINT SPC(64):LOCATE 23,1:PRINT "SEARCH FOR: ";X$;:LOCATE 23,50:PRINT"Current Cnt:";J:PRINT TAB(50);"Current Sum:";TOT;:IF RNO=1 AND Y$="B" THEN LOCATE 23,30:PRINT "First Record..."
  37. 575 LOCATE 24,1,1:LINE INPUT;"Option:";Y$:IF LEN(Y$)>64 THEN 575:ELSE DFLG=1
  38. 600 IF B<>DS2 AND Y$="" AND Z=0 THEN GOSUB 7120:GOSUB 3000:GOTO 250:ELSE IF Y$="" THEN GOSUB 7107:DFLG=0:GOTO 505
  39. 605 IF (LEN(Y$)=1 AND (ASC(Y$)<65 OR ASC(Y$)>122)) OR (LEN(Y$)>1 AND CHR$(ASC(Y$) AND 223)<>"P") THEN TEMP$=X$:X$=Y$:GOTO 165
  40. 607 ON (ASC(Y$) AND 223)-64 GOTO 610,612,614,616,618,700,700,700,700,700,700,700,634,100,638,4000,700,640,646,700,700,700,654,700,700,656
  41. 608 GOTO 700
  42. 610 LET Y$="ADD":GOTO 700
  43. 612 Y$="B":GOSUB 3100:IF RNO>0 THEN GOSUB 7120:GOTO 275:ELSE LOCATE 23,1:PRINT "No records to show...";:FFLG=0:GOTO 575
  44. 614 IF B<>DS2 THEN DFLG=0:GOSUB 7107:GOTO 5020:ELSE GOTO 575
  45. 616 IF B<>DS2 THEN DFLG=0:GOSUB 8990:GOTO 100:ELSE GOTO 575
  46. 618 IF B<>DS2 THEN DFLG=0:GOSUB 7107:Y$="e":GOTO 5020:ELSE GOTO 575
  47. 634 DFLG=0:GOSUB 7100:GOTO 505
  48. 638 DFLG=0:DV=3:GOSUB 4200:GOTO 505
  49. 640 GOSUB 7120:GOSUB 11000:IF Z=1 OR (LEFT$(X$,1)=">" AND TEMP$<>"") THEN X$=TEMP$
  50. 645 GOTO 170
  51. 646 GOSUB 20100:GOTO 1000
  52. 654 DFLG=0:GOTO 4100
  53. 656 LNX$=CHR$(26):GOSUB 4330:GOTO 505
  54. 700 TEMP$=X$:X$=Y$:GOTO 165
  55. 800 GOSUB 7107:GOTO 505
  56. 810 RESUME 295
  57. 1000 POKE 105,22:GOSUB 7110:LOCATE 24,1,1:LINE INPUT;"Option:";Y$:IF Y$="e" OR Y$="E" OR Y$="c" OR Y$="C" THEN 1010:ELSE GOTO 600
  58. 1010 GOSUB 7120:LOCATE 1,1,0:POKE F,5:CALL G:GOTO 600
  59. 2000 PRINT "ENTER/Search More    N/New (Main Menu)     R/Restart Search   D/Delete Record   E/Edit Record        A/Add New Record      C/Copy Record      M/More Commands":RETURN
  60. 2040 PRINT">/Midsearch Prefix    P(#)/Print Record   O/Out to RS232   S/Status Display     W/Write to Textfile   M/More Commands     Z/Serial EOF     B/Back Step":RETURN
  61. 2050 PRINT"You may also enter a new Search Command, or any of the other Main Menu functionsEx: RST, CHAT, NNAM, SAVE, LOAD, MERG, DEFO, BAUD, SORT, etc.  M/More Commands":RETURN
  62. 3000 'Subroutine to store pointers
  63. 3010 RNO=RNO+1:LET PAST$(RNO)=CHR$(PEEK(22))+CHR$(PEEK(23))+CHR$(PEEK(20))+CHR$(PEEK(21))+CHR$(PEEK(24))+CHR$(PEEK(25))
  64. 3020 PAST$(RNO)=PAST$(RNO)+CHR$(PEEK(26))+CHR$(PEEK(27))+CHR$(PEEK(32))+CHR$(PEEK(33))+CHR$(PEEK(18))+CHR$(PEEK(19))
  65. 3030 PAST$(RNO)=PAST$(RNO)+CHR$(PEEK(28))+CHR$(PEEK(29))+CHR$(PEEK(4))+CHR$(PEEK(5))+CHR$(PEEK(34))+CHR$(PEEK(35)):PST(RNO,1)=J:PST(RNO,2)=TOT
  66. 3040 IF RNO<20 THEN RETURN:ELSE RNO=19:FOR L=1 TO 19:PAST$(L)=PAST$(L+1):PST(L,1)=PST(L+1,1):PST(L,2)=PST(L+1,2):NEXT:RETURN
  67. 3100 'Subroutine to restore pointers when back-stepping
  68. 3102 IF RNO=0 THEN RETURN
  69. 3105 FOR Y=1 TO 18:PCD(Y)=ASC(MID$(PAST$(RNO),Y,1)):NEXT Y:J=PST(RNO,1):TOT=PST(RNO,2)
  70. 3110 POKE 22,PCD(1):POKE 23,PCD(2):POKE 20,PCD(3):POKE 21,PCD(4):POKE 24,PCD(5):POKE 25,PCD(6):POKE 26,PCD(7):POKE 27,PCD(8):POKE 32,PCD(9):POKE 33,PCD(10)
  71. 3120 POKE 18,PCD(11):POKE 19,PCD(12):POKE 28,PCD(13):POKE 29,PCD(14):POKE 4,PCD(15):POKE 5,PCD(16):POKE 34,PCD(17):POKE 35,PCD(18)
  72. 3130 RNO=RNO+(RNO>1):B=0:IF PCD(3)+256*PCD(4)=DS THEN DBLK=1:POKE 0,FNB(DS):POKE 1,FNC(DS):POKE 16,FNB(DS):POKE 17,FNC(DS):ELSE DBLK=2:POKE 0,FNB(DS2):POKE 1,FNC(DS2):POKE 16,FNB(DS2):POKE 17,FNC(DS2)
  73. 3140 POKE 2,FNB(P(DBLK)):POKE 3,FNC(P(DBLK)):RETURN
  74. 3500 'Routine to merge data with ASCII document (Mail Merge)
  75. 3510 GOSUB 20200:PRINT:PRINT"This procedure will add FINDEX data to a word processed ASCII document.":PRINT"Results of the merging are printed out in a FORM letter."
  76. 3512 FDR$=CHR$(ASC("A")+(2*(HARD AND ENGAGED)))+":"
  77. 3515 ON ERROR GOTO 0:IF Z THEN GOSUB 20200:PRINT:PRINT"The document filename you entered could not be loaded from Drive ";FDR$;". Try again.":Z=0
  78. 3520 PRINT:PRINT"Enter the name of the document file using standard XXXXXXXX.YYY format, or       type: D to produce a Directory of drive ";FDR$:PRINT TAB(8)"JUST ENTER TO RETURN TO THE FINDEX MAIN MENU"
  79. 3530 PRINT:LINE INPUT "Selection? ";FM$:IF FM$="" THEN GOTO 100
  80. 3540 IF FM$="D" OR FM$="d" THEN GOSUB 20200:FILES FDR$+"*.*":GOTO 3520
  81. 3545 B=0:WFLG=0:LOCATE 20,1,0:PRINT STRING$(23,205);" Press <Q> to Return to Main Menu ";STRING$(23,205);
  82. 3550 ON ERROR GOTO 3950:OPEN "I",#3,FDR$+FM$:ON ERROR GOTO 3990
  83. 3560 IF EOF(3) THEN CLOSE#3:LPRINT:ON 1-(B=0) GOTO 100,3550
  84. 3570 LINE INPUT#3,K$
  85. 3575 XA=1:OXA=1:RT$=K$:GOSUB 7107:PRINT K$
  86. 3580 KB$=INKEY$:IF KB$="Q" OR KB$="q" THEN CLOSE#3:FFLG=0:LPRINT:GOTO 100
  87. 3582 XA=INSTR(XA,K$,"["):IF XA=0 THEN 3900
  88. 3585 ON ERROR GOTO 3710:YA=INSTR(XA,K$,"]"):LF$=MID$(K$,OXA,XA-OXA):CMD$=MID$(K$,XA,YA-XA+1):RT$=RIGHT$(K$,LEN(K$)-YA):OXA=YA+1:XA=YA:ON ERROR GOTO 3990
  89. 3586 IF WFLG=0 THEN LPRINT LF$;
  90. 3590 IF CMD$="[XON]" OR CMD$="[xon]" THEN WFLG=0:GOTO 3580
  91. 3595 IF CMD$="[XOFF]" OR CMD$="[xoff]" THEN WFLG=1:GOTO 3580
  92. 3600 IF (LEFT$(CMD$,3)="[S:" OR LEFT$(CMD$,3)="[s:") AND WFLG=0 THEN X$=MID$(CMD$,4,LEN(CMD$)-4):FFLG=1:SOK=1:GOSUB 166:GOTO 3580
  93. 3602 IF LEFT$(CMD$,3)="[S:" OR LEFT$(CMD$,3)="[s:" THEN 3580
  94. 3605 IF CMD$="[N]" OR CMD$="[n]" THEN Y$="":FFLG=1:IF B=0 AND SOK THEN GOSUB 600:GOTO 3580:ELSE GOSUB 3000:GOTO 3580
  95. 3610 IF (CMD$="[B]" OR CMD$="[b]") AND SOK THEN Y$="B":FFLG=1:GOSUB 600:GOTO 3580
  96. 3615 IF LEFT$(CMD$,3)="[L:" OR LEFT$(CMD$,3)="[l:" THEN X=VAL(RIGHT$(CMD$,LEN(CMD$)-3)):GOTO 3850
  97. 3620 CD=ASC(RIGHT$(CMD$,LEN(CMD$)-1)):IF CD>47 AND CD<58 THEN CD=VAL(RIGHT$(CMD$,LEN(CMD$)-1)):IF CD<256 AND WFLG=0 THEN LPRINT CHR$(CD);:GOTO 3580:ELSE GOTO 3580
  98. 3625 IF (CMD$="[C]" OR CMD$="[c]") AND WFLG=0 THEN LPRINT J;:GOTO 3580
  99. 3630 IF (CMD$="[T]" OR CMD$="[t]") AND WFLG=0 THEN LPRINT TOT;:GOTO 3580
  100. 3635 IF (CMD$="[D]" OR CMD$="[d]") AND WFLG=0 THEN LPRINT DATE$:GOTO 3580
  101. 3640 IF (CMD$="[I]" OR CMD$="[i]") AND WFLG=0 THEN GOSUB 7107:LINE INPUT "Enter text:";LNX$:GOSUB 7107:PRINT Y$:LPRINT LNX$;:GOTO 3580
  102. 3645 IF (CMD$="[R]" OR CMD$="[r]") AND B=0 THEN IF WFLG=0 THEN LPRINT:GOTO 3575:ELSE GOTO 3575
  103. 3700 GOTO 3900
  104. 3710 LF$="":CMD$="":RT$="":RESUME 3900
  105. 3850 IF X>0 AND X<20 THEN GOSUB 3997:IF WFLG=0 THEN LPRINT LNX$;:GOTO 3580
  106. 3900 IF WFLG=0 THEN LPRINT RT$
  107. 3910 GOTO 3560
  108. 3950 Z=1:RESUME 3515
  109. 3990 GOSUB 7107:PRINT "Printer ERROR!!!":LINE INPUT "ENTER: P to resume printing or any other key to return to Main Menu/";KB$:GOSUB 7107:IF KB$="P" OR KB$="p" THEN PRINT K$:RESUME:ELSE CLOSE#3:FFLAG=0:RESUME 100
  110. 3997 LNGE=0:WHILE RIGHT$(E$(X),LEN(E$(X))-LNGE)<>SPACE$(LEN(E$(X))-LNGE):LNGE=LNGE+1:WEND
  111. 3998 LNX$=LEFT$(E$(X),LNGE):RETURN
  112. 3999 STOP
  113. 4000 '
  114. 4010 IF Y$="P" OR Y$="p" THEN LET D=1:GOTO 4020
  115. 4015 TEMP$=RIGHT$(Y$,LEN(Y$)-1):SWAP TEMP$,L$:GOSUB 7600:SWAP TEMP$,L$:IF Z=1 THEN LET D=VAL(TEMP$):Z=0:ELSE 700
  116. 4020 POKE 105,24:GOSUB 7110
  117. 4030 DV=1:FOR N=1 TO D:GOSUB 4200
  118. 4050 NEXT N:IF LEFT$(K$,1)=CHR$(17) THEN 5030:ELSE GOTO 505
  119. 4100 '
  120. 4110 GOSUB 7107:LOCATE 22,1,1:IF FX$<>"" THEN 4140
  121. 4113 IF FUNC$="W" THEN POKE 105,20:GOSUB 7110
  122. 4115 PRINT "ASCII Textfile not yet declared with the ASCI command. ":IF FUNC$="W" THEN LOCATE 1,1:GOSUB 20201:GOTO 110:ELSE GOTO 560
  123. 4140 DV=2:GOSUB 4200:IF Y$="w" OR Y$="W" THEN CLOSE :OPEN"a",#2,FDR$+FX$+".txt"
  124. 4165 IF FUNC$="W" OR FUNC$="O" THEN 250:ELSE GOSUB 7107:GOTO 505
  125. 4200 FOR Y=1 TO LEN(LX$):X=ASC(MID$(LX$,Y,1))-128:IF X=0 THEN 4210
  126. 4205 LNGE=0:WHILE RIGHT$(E$(X),LEN(E$(X))-LNGE)<>SPACE$(LEN(E$(X))-LNGE):LNGE=LNGE+1:WEND
  127. 4206 LNX$=LEFT$(E$(X),LNGE)
  128. 4210 ON DV GOSUB 4300,4310,4320
  129. 4220 ON ERROR GOTO 0:NEXT Y:RETURN
  130. 4300 ON ERROR GOTO 4991:IF X=0 THEN LPRINT:RETURN:ELSE LPRINT LNX$:RETURN
  131. 4310 ON ERROR GOTO 4992:IF X=0 THEN PRINT #2:RETURN:ELSE PRINT#2,LNX$:RETURN
  132. 4320 IF X=0 THEN LNX$=""
  133. 4325 LNX$=LNX$+CHR$(13)
  134. 4330 ON ERROR GOTO 4990:FOR I=1 TO LEN(LNX$):ON RATE GOSUB 8280,8281,8282,8283,8284,8285
  135. 4350 PRINT #1,MID$(LNX$,I,1);:CLOSE#1:NEXT I
  136. 4360 ON ERROR GOTO 0:RETURN
  137. 4370 STOP
  138. 4990 RESUME
  139. 4991 GOSUB 7107:PRINT "Printer ERROR!!!":LINE INPUT "Enter: P to resume printing or any other key to return to Main Menu/";K$:IF K$="P" OR K$="p" THEN RESUME 4300:ELSE RESUME 100
  140. 4992 GOSUB 7107:CLOSE:BEEP:PRINT "Disk ERROR!!!   Write Canceled. Press any key to return to Main Menu/":WHILE INKEY$="":WEND:RESUME 100
  141. 5000 '
  142. 5010 CLS:FOR X=1 TO 19:E$(X)=STRING$(80," "):NEXT X
  143. 5020 I(1)=7:I(2)=0:GOSUB 20130:LOCATE 1,1,1
  144. 5030 K$=INKEY$:IF K$="" THEN GOTO 5030
  145. 5035 OC=POS(0):IF ASC(K$)<32 THEN GOTO 5500:ELSE IF ASC(K$)=127 THEN 5740
  146. 5040 IF I(1)=7 THEN MID$(E$(CSRLIN),POS(0),LEN(K$))=K$:PRINT K$;:GOTO 5050
  147. 5045 LOCATE CSRLIN,POS(0),0:TEMP$=LEFT$(E$(CSRLIN),POS(0)-1)+K$+RIGHT$(E$(CSRLIN),81-POS(0)):C=POS(0)+LEN(K$)-1:E$(CSRLIN)=LEFT$(TEMP$,80):PRINT RIGHT$(E$(CSRLIN),81-POS(0));
  148. 5046 LOCATE(CSRLIN+(C<80)),C*-(C<80)+1,1
  149. 5050 IF OC=80 THEN LOCATE CSRLIN,1
  150. 5060 IF CSRLIN>19 THEN LOCATE 1,1,1
  151. 5400 GOTO 5030
  152. 5500 ON (32-ASC(K$))GOTO 5510,5520,5530,5540,5550,5560,5570,5580,5590,5600,5610,5620,5630,5640,5650,5660,5670,5680,5690,5700,5710,5720,5730,5740
  153. 5501 IF ASC(K$)=0 AND LEN(K$)>1 THEN K$=CHR$(KV(ASC(RIGHT$(K$,1)))):GOTO 5035
  154. 5502 IF ASC(K$)>0 THEN 5750
  155. 5505 GOTO 5030
  156. 5510 IF CSRLIN<19 THEN LOCATE CSRLIN+1,POS(0)
  157. 5515 GOTO 5030
  158. 5520 LOCATE CSRLIN+(CSRLIN>1),POS(0):GOTO 5030
  159. 5530 C=POS(0)-(POS(0)<81):IF C=81 THEN C=1
  160. 5531 GOTO 5541
  161. 5540 C=POS(0)-1:IF C=0 THEN C=80:IF CSRLIN>1 THEN LOCATE CSRLIN-1,C
  162. 5541 LOCATE CSRLIN,C:GOTO 5030
  163. 5550 L=CSRLIN:C=POS(0):GOSUB 7107:LINE INPUT"ESCAPE! (Y/N)";K$:IF K$="y" OR K$="Y" THEN 5555:ELSE GOSUB 20140:GOTO 5591
  164. 5555 IF Y$="e" OR Y$="E" OR Y$="c" OR Y$="C" THEN GOSUB 7130:GOTO 275:ELSE 100
  165. 5560 SWAP E$(1),E$(CSRLIN):L=CSRLIN:C=POS(0):LOCATE 1,1:PRINT E$(1);:LOCATE L,1:PRINT E$(L);:GOTO 5591
  166. 5570 GOTO 5030
  167. 5580 K$=DATE$+" ":IF LEN(K$)+POS(0)>80 THEN 5030:ELSE GOTO 5040
  168. 5590 L=CSRLIN:C=POS(0):GOSUB 7100:ON LODIS GOSUB 20130,20170,5592
  169. 5591 LOCATE L,C,1:GOTO 5030
  170. 5592 LODIS=0:LOCATE L,C:RETURN 5590
  171. 5600 LET L=-1:GOTO 5630
  172. 5610 C=POS(0):IF C>1 THEN E$(CSRLIN)=LEFT$(E$(CSRLIN),C-1)+SPACE$(81-C):PRINT SPC(81-C);:LOCATE CSRLIN-1,C:GOTO 5030:' line erase
  173. 5611 L=CSRLIN:E$(L)=SPACE$(80):PRINT E$(L);:LOCATE L,C:GOTO 5030
  174. 5620 L=CSRLIN:C=POS(0):GOSUB 20100:LOCATE 8,40,0:PRINT "<<<<<<<<PRESS ANY KEY TO CONTINUE>>>>>>>>"
  175. 5621 IF INKEY$="" THEN GOTO 5621:ELSE FOR X=7 TO 16:LOCATE X,40,0:PRINT RIGHT$(E$(X),41);:NEXT X:GOTO 5591
  176. 5630 IF Y$="e" THEN GOSUB 8990
  177. 5631 TDK=DBLK:GOSUB 11000
  178. 5632 FOR X=1 TO 19: GOSUB 7200
  179. 5633 POKE F,1:CALL G:IF PEEK(43)=1 THEN GOTO 6500:ELSE NEXT X:POKE F,2:CALL G:LET P(DBLK)=FNA(2)
  180. 5634 IF TDK<>DBLK THEN GOSUB 11050
  181. 5635 Y$="":IF L=-1 THEN L=0:GOTO 9000:ELSE IF X$="SERI" OR X$="MERG" THEN GOTO 8080:ELSE GOTO 100
  182. 5640 L=CSRLIN:C=POS(0):FOR X=CSRLIN TO 18:E$(X)=E$(X+1):NEXT X:E$(19)=SPACE$(80)
  183. 5641 POKE 103,6:IF L=19 THEN 5662
  184. 5642 POKE 101,1:POKE 105,L-1:POKE 107,0:POKE 109,18:POKE 111,79:POKE 113,7:POKE F,0:CALL G:GOTO 5591
  185. 5650 D=1:GOTO 4030
  186. 5660 L=CSRLIN:C=POS(0):FOR X=18 TO L STEP-1:E$(X+1)=E$(X):NEXT X:E$(L)=SPACE$(80):'line insert
  187. 5661 IF L<19 THEN POKE 103,7:GOTO 5642
  188. 5662 LOCATE 19,1:PRINT E$(L);:LOCATE L,C:GOTO 5030
  189. 5670 SWAP I(1),I(2):L=CSRLIN:C=POS(0):GOSUB 20130:GOTO 5591
  190. 5680 GOTO 5030
  191. 5690 PRINT:GOTO 5050
  192. 5700 LOCATE 1,1:GOTO 5030
  193. 5710 GOTO 5030
  194. 5720 GOTO 5510
  195. 5730 FOR C=POS(0)+1 TO 75:IF C/5=INT(C/5) THEN 5731:ELSE NEXT C:C=1
  196. 5731 LOCATE CSRLIN,C:GOTO 5030
  197. 5740 L=CSRLIN:C=POS(0):E$(L)=LEFT$(E$(L),C-1)+RIGHT$(E$(L),80-C)+" ":LOCATE L,1,0:PRINT E$(L);
  198. 5741 IF ASC(K$)=127 THEN LOCATE L,C,1:GOTO 5030:ELSE LOCATE L,C+(C>1),1:GOTO 5030
  199. 5750 IF LEN(M$(ASC(K$)))+POS(0)>80 THEN 5030:ELSE K$=M$(ASC(K$)):GOTO 5040
  200. 6000 K$=CHR$(3):RESUME 5750
  201. 6010 STOP
  202. 6500 IF DBLK=1 THEN GOTO 6520
  203. 6505 CLS:PRINT "Warning...":PRINT "Database is FULL!":PRINT:PRINT"This record could not be added. Press any key to go to Main Menu"
  204. 6510 IF INKEY$="" THEN GOTO 6510:ELSE LET P(2)=FNA(2):GOSUB 11000:POKE 43,0:GOTO 100
  205. 6520 GOSUB 11050:POKE 43,0:GOTO 5632:'IF X$="MERG" THEN 8080:ELSE GOTO 5632
  206. 7000 U$=MID$(U$,1,X-1)+CHR$(TOK)+MID$(U$,X+LEN(TOK$)):RETURN
  207. 7100 '
  208. 7105 LODIS=-(LODIS<3)*LODIS+1
  209. 7107 POKE 105,20
  210. 7110 POKE 101,0:POKE 103,6:POKE 107,0:POKE 109,23:POKE 111,79:POKE 113,7:POKE F,0:CALL G:LOCATE 21,1,1:RETURN
  211. 7120 '
  212. 7130 LOCATE 1,1,0:POKE 101,0:POKE 103,7:POKE 105,0:POKE 107,0:POKE 109,18:POKE 111,79:POKE 113,7:POKE F,0:CALL G
  213. 7140 RETURN
  214. 7200 T$=E$(X)
  215. 7210 DEF SEG:N2=PEEK(1+VARPTR(T$))+256*PEEK(2+VARPTR(T$)):DEF SEG=MC:POKE 8,FNB(BAS):POKE 9,FNC(BAS):POKE 10,FNB(N2):POKE 11,FNC(N2):RETURN
  216. 7300 '
  217. 7305 X=1:OB=INSTR(X,U$,CHR$(253))
  218. 7310 Z=INSTR(X,U$,CHR$(253)):IF Z=0 THEN Z=LEN(U$)
  219. 7320 L=INSTR(X,U$,CHR$(1)):C=INSTR(X,U$,CHR$(255)):IF L<Z AND C<Z AND L<>0 AND C<>0 THEN Z=1:RETURN
  220. 7330 IF Z<LEN(U$) THEN X=Z+1:GOTO 7310:ELSE Z=0:RETURN
  221. 7400 ' *** DEFO Command Processor ***
  222. 7410 D=0:IF X$<>Y$ THEN POKE 105,16:GOSUB 7110
  223. 7420 GOSUB 9110
  224. 7425 FOR X=1 TO 6:LOCATE X+8,41:PRINT X;"-";LEFT$(FOP$(X),10):NEXT X:FOR X=7 TO 12:LOCATE X+2,61:PRINT X;"-";LEFT$(FOP$(X),10):NEXT X:COLOR 3,0
  225. 7426 GOSUB 7107:LOCATE 22,1,1:PRINT"Select format number, type CREATE, or press just ENTER to escape this procedure"
  226. 7427 G$=L$:IF D<>0 THEN GOTO 7450
  227. 7430 LINE INPUT L$:IF L$="create" OR L$="CREATE" THEN GOTO 7700:ELSE IF L$="" THEN L$=G$:GOTO 7450:ELSE GOSUB 7600
  228. 7435 IF Z=0 THEN GOSUB 7107:PRINT"Numbers 1-12 only. Or type -CREATE-":GOTO 7430:ELSE X=VAL(L$)
  229. 7440 IF LEFT$(FOP$(X),10)="Not Used  " THEN GOTO 7650
  230. 7445 LET L$=LEFT$(FOP$(X),10):LET LX$=RIGHT$(FOP$(X),LEN(FOP$(X))-10)
  231. 7450 GOSUB 7107:Z=0:IF X$=Y$ THEN X$=TEMP$:GOSUB 2000:GOTO 646:ELSE GOTO 100
  232. 7600 IF L$="1" OR L$="2" OR L$="3" OR L$="4" OR L$="5" OR L$="6" OR L$="7" OR L$="8" OR L$="9" OR L$="10" OR L$="11" OR L$="12" THEN LET Z=1:ELSE Z=0
  233. 7605 IF Z=1 OR T$="DEFO" THEN RETURN
  234. 7610 IF L$="13" OR L$="14" OR L$="15" OR L$="16" OR L$="17" OR L$="18" OR L$="19" THEN Z=1:ELSE Z=0
  235. 7615 RETURN
  236. 7650 LOCATE 22,1,1:GOSUB 7107:PRINT"Format must first be CREATED. Please type -CREATE-":GOTO 7430
  237. 7700 POKE 105,21:GOSUB 7110:LOCATE 22,1:LINE INPUT "Select # to DEFINE (1-12)";L$:IF L$="" THEN L$=G$:GOTO 7450:ELSE GOSUB 7600:IF Z=0 THEN GOTO 7700:ELSE X=VAL(L$)
  238. 7704 GOSUB 7107:LINE INPUT "Enter format NAME (10 characters max.)";L$:IF L$="" THEN LET L$="Format"+STR$(X):ELSE IF LEN(L$)>10 THEN 7704
  239. 7705 GOSUB 7107
  240. 7707 IF Z=0 THEN PRINT"Input Error! Try again...      ";
  241. 7710 LINE INPUT "Type line numbers in sequence of output. Separate with slash. Use 0 to signify  blank lines (EX: 1/2/3/0/1  etc.)";LX$
  242. 7715 LX$=LX$+"/"
  243. 7720 IF ASC(LX$)=47 THEN GOTO 7705:ELSE A$=""
  244. 7730 FOR N=1 TO LEN(LX$):D=ASC(MID$(LX$,N,1)):IF D<47 OR D>57 THEN GOTO 7705:ELSE NEXT N:D=1
  245. 7735 IF INSTR(LX$,"//")<>0 THEN Z=0:GOTO 7705
  246. 7740 N=VAL(MID$(LX$,D,LEN(LX$)-D)):A$=A$+CHR$(N):IF N>19 THEN Z=0:GOTO 7705
  247. 7750 D=1+INSTR(D,LX$,"/"):IF D>=LEN(LX$) THEN 7775:ELSE GOTO 7740
  248. 7775 L$=L$+"          ":L$=LEFT$(L$,10):FOR D=1 TO LEN(A$):MID$(A$,D,1)=CHR$(128+ASC(MID$(A$,D,1))):NEXT D
  249. 7780 LET FOP$(X)=L$+A$:OPEN "O",#1,"FORMAT.BAS":FOR N=1 TO 12:PRINT#1,FOP$(N):NEXT N: CLOSE#1:GOTO 7445
  250. 7800 K$=X$:' *** TOKN Command Processor ***
  251. 7801 GOSUB 9110:LOCATE 8,41:PRINT "Current Tokens:";TKN$:FOR X=1 TO 7:LOCATE 8+X,41:PRINT CHR$(64+X);"/";M$(X):NEXT:COLOR 3,0:GOSUB 7107:LINE INPUT"Enter letter of token to define (A-G), X to NAME file or ENTER to finish:";X$:IF X$="" THEN 7803
  252. 7802 GOSUB 9585:IF T$="X" THEN T$="TOKEN":GOSUB 7820:GOTO 7801:ELSE IF T$<"A" OR T$>"G" THEN 7801:ELSE PRINT"Now enter text (32 Chars. MAX) for token/";T$;":";:LINE INPUT MX$:M$(ASC(T$)-64)=LEFT$(MX$,32):GOTO 7801
  253. 7803 IF TKN$="" THEN TKN$="NoName":GOTO 7803:ELSE OPEN"O",#1,TKN$+".tkn":FOR X=1 TO 7:PRINT#1,M$(X):NEXT:CLOSE#1
  254. 7804 X$=K$:GOTO 9230
  255. 7810 K$=X$:X$="A:":ON ERROR GOTO 7815
  256. 7811 LINE INPUT"Enter token filename:";T$:GOSUB 7107:IF T$="" THEN 7804
  257. 7812 OPEN"I",#1,X$+T$+".tkn":FOR X=1 TO 7:INPUT#1,M$(X):NEXT:CLOSE#1:TKN$=T$:ON ERROR GOTO 0:GOTO 7804
  258. 7815 IF X$="A:" THEN X$="B:":RESUME
  259. 7816 PRINT "Disk Error or File Not Found":X$=K$:RESUME 7810
  260. 7820 GOSUB 9210:IF G$="" THEN RETURN:ELSE SWAP F$,G$:TKN$=G$:RETURN
  261. 7900 '
  262. 7901 OPEN "o",#1,"FORMAT.BAS":FOR X=1 TO 12:PRINT#1;"Not Used  ":NEXT X:CLOSE #1:RESUME
  263. 8000 GOSUB 7107:Z$=L$:INPUT "lines per record";L$:GOSUB 7600:SWAP L$,Z$:IF Z=0 THEN 8000:ELSE Z=0:A=VAL(Z$)
  264. 8005 FOR X=1 TO 19:E$(X)=SPACE$(80):NEXT X:IF X$="SERI" THEN PRINT"Serial input. Stand by...":SFLG=1:GOTO 8022
  265. 8007 DR$="A:":IF HARD AND ENGAGED THEN DR$="C:"
  266. 8010 LET Q$=F$:GOSUB 9212:SWAP F$,Q$:PRINT "Merging. Stand by...":OP1=P(1):OP2=P(2):CLOSE
  267. 8020 ON ERROR GOTO 8200:OPEN "i",#1,DR$+Q$+".TXT":ON ERROR GOTO 0
  268. 8022 Z$=""
  269. 8025 X=1:N=X:FOR L=1 TO A
  270. 8026 IF X$="SERI" THEN ON SFLG GOTO 8242,8250
  271. 8030 IF EOF(1) AND Z$="" THEN CLOSE#1:X$="":FOR X=L TO A:E$(X)=SPACE$(80):NEXT X:GOTO 8070
  272. 8040 ON ERROR GOTO 8100:IF Z$="" THEN LINE INPUT#1,Y$:ELSE Y$=Z$:Z$=""
  273. 8042 IF LEN(Y$)>80 THEN Z$=RIGHT$(Y$,LEN(Y$)-80):Y$=LEFT$(Y$,80):GOTO 8050
  274. 8050 E$(X)=Y$+SPACE$(80-LEN(Y$)):X=X+1:IF X>A THEN 8070
  275. 8060 NEXT L
  276. 8070 GOTO 5631
  277. 8080 GOTO 8025
  278. 8100 GOSUB 7107:PRINT"Disk READ Error...  Data input canceled. Press any key to return to Menu.":BEEP:P(1)=OP1:P(2)=OP2:CLOSE#1:DEF SEG=DS:POKE P(1),128:DEF SEG=DS2:POKE P(2),128:DEF SEG=MC
  279. 8110 WHILE INKEY$="":WEND:RESUME 100
  280. 8200 IF DR$="A:" THEN DR$="B:":RESUME
  281. 8220 PRINT Q$;" file is not on disk.":INPUT "Options: DISK for Disk Index, ENTER for Menu, or new FILENAME";X$:CLOSE #1:IF X$="" THEN X$="MERG":RESUME 9230:ELSE IF X$="DISK" OR X$="disk" THEN RESUME 9000
  282. 8230 GOSUB 7107:LOCATE 23,1:DR$="A:":Q$=X$:X$="MERG":RESUME 8020
  283. 8242 IF Z$<>"" THEN 8045:ELSE Y$=""
  284. 8245 ON ERROR GOTO 8260:ON RATE GOSUB 8280,8281,8282,8283,8284,8285
  285. 8246 ON COM(1) GOSUB 8249:COM(1) ON
  286. 8247 WHILE INKEY$="":WEND:COM(1) OFF:ERROR 100
  287. 8249 COM(1) OFF:RETURN 8250
  288. 8250 LINE INPUT#1,Y$:IF Y$=CHR$(26) THEN Y$="":GOTO 8270
  289. 8255 ON ERROR GOTO 0:SFLG=2:GOTO 8042
  290. 8260 IF INKEY$<>"" OR ERR=100 THEN Y$="":RESUME 8270:ELSE RESUME
  291. 8270 ON ERROR GOTO 0:CLOSE#1
  292. 8275 E$(L)=Y$+SPACE$(80-LEN(Y$)):FOR X=L+1 TO A:E$(X)=SPACE$(80):NEXT X:X$="":X=1:GOTO 8070
  293. 8280 OPEN "COM1:300,N,8,1" AS #1:RETURN
  294. 8281 OPEN "COM1:600,N,8,1" AS #1:RETURN
  295. 8282 OPEN "COM1:1200,N,8,1" AS #1:RETURN
  296. 8283 OPEN "COM1:2400,N,8,1" AS #1:RETURN
  297. 8284 OPEN "COM1:4800,N,8,1" AS #1:RETURN
  298. 8285 OPEN "COM1:9600,N,8,1" AS #1:RETURN
  299. 8300 LINE INPUT "Enter Desired Baud Rate:";T$:IF T$="" THEN 7450:ELSE IF T$="300" OR T$="600" OR T$="1200" OR T$="2400" OR T$="4800" OR T$="9600" THEN 8310:ELSE GOSUB 7107:GOTO 8300
  300. 8310 R=VAL(T$):R2=300:FOR RATE=1 TO 6:IF R<>R2 THEN R2=2*R2:NEXT RATE
  301. 8320 GOTO 7450
  302. 8500 IF FUNC$="W" AND FX$="" THEN 4113
  303. 8505 IF B=DS2 THEN LOCATE 1,1,0:DFLG=0:GOTO 320
  304. 8510 IF FUNC$="D" THEN GOSUB 8990:GOTO 250
  305. 8520 IF FUNC$="W" THEN Y$="W":GOTO 4100
  306. 8530 IF FUNC$="S" THEN 250
  307. 8540 IF FUNC$="T" THEN 250
  308. 8550 IF FUNC$="O" THEN DV=3:GOSUB 4200:GOTO 4165
  309. 8560 IF FUNC$="P" THEN DV=1:GOSUB 4200:GOTO 250
  310. 8900 GOTO 320
  311. 8990 POKE F,6:CALL G:P(DBLK)=P(DBLK)-FNA(94):RETURN
  312. 9000 GOSUB 7107:DFLG=0:GOSUB 9585
  313. 9005 IF T$="NNAM" THEN 9200
  314. 9010 IF T$="MORE" THEN 9900
  315. 9015 IF T$="RST" THEN X$=T$:GOSUB 10040:GOTO 100
  316. 9020 IF T$="ADD" THEN 5000
  317. 9025 IF T$="DISK" THEN GOSUB 9500:GOTO 9000
  318. 9030 IF T$="SAVE" THEN 9300
  319. 9035 IF T$="ASCI" THEN GOSUB 7107:LOCATE 24,1:INPUT;"Enter NAME for WRITE file";G$:IF G$="" THEN 9230:ELSE GOSUB 7107:GOSUB 9213:IF G$="" THEN 9230:ELSE SWAP F$,G$:FX$=G$:CLOSE:GOTO 9190
  320. 9040 IF T$="LOAD" THEN 9400
  321. 9045 IF T$="SORT" THEN 9700
  322. 9050 IF T$="DEFO" THEN 7400
  323. 9055 IF T$="CHAT" THEN SWAP G$,L$:LINE INPUT "Enter line number which holds the number to tally:";L$:GOSUB 7600:SWAP G$,L$:IF G$="" THEN 7450:ELSE IF Z=0 THEN GOTO 9000:ELSE T=VAL(G$):Z=0:G$=X$:GOTO 7450
  324. 9060 IF T$="MERG" OR T$="SERI" THEN X$=T$:GOTO 8000
  325. 9065 IF T$="BAUD" THEN G$=X$:GOTO 8300
  326. 9070 IF T$="TOKN" THEN 7800
  327. 9075 IF T$="EXIT" THEN BEEP:LINE INPUT "EXIT to DOS... Are you sure (Y/N)";X$:IF X$="Y" OR X$="y" THEN SYSTEM:ELSE GOTO 100
  328. 9080 IF T$="TLOD" THEN 7810
  329. 9085 IF T$="FORM" THEN 3500
  330. 9090 IF T$="SDAT" THEN GOSUB 7107:ON ERROR GOTO 9101:LINE INPUT "Enter Date (MM/DD/YY)";G$:DATE$=G$:ON ERROR GOTO 0:G$=X$:GOTO 7450
  331. 9095 IF T$="HARD" THEN ENGAGED=ABS(ENGAGED-1):GOTO 9230
  332. 9100 GOTO 170
  333. 9101 IF G$="" THEN RESUME 7450:ELSE RESUME 9090
  334. 9110 POKE 101,0:POKE 103,7:POKE 105,7:POKE 107,39:POKE 109,14:POKE 111,79:POKE 113,112:POKE F,0:CALL G:LOCATE 9,41,0:COLOR 0,7:RETURN
  335. 9150 IF FDR$="A:" THEN FDR$="B:":RESUME:ELSE FDR$="A:":RESUME 9195
  336. 9190 FDR$="A:":IF HARD AND ENGAGED THEN FDR$="C:"
  337. 9192 ON ERROR GOTO 9150:OPEN "I",#2,FDR$+FX$+".TXT":CLOSE#2:ON ERROR GOTO 0
  338. 9195 IF HARD AND ENGAGED THEN FDR$="C:"
  339. 9199 OPEN "a",#2,FDR$+FX$+".txt":GOTO 9230
  340. 9200 '
  341. 9210 GOSUB 7107
  342. 9212 LOCATE 23,1,1:PRINT "Enter New FILENAME for ";T$;"ing:";:LINE INPUT G$:LOCATE 23,1,0:GOSUB 7107:IF G$="NoName" THEN 9210:ELSE IF G$="" THEN 9225
  343. 9213 SWAP F$,G$
  344. 9214 IF LEN(F$)>8 THEN GOTO 9250:ELSE FOR X=1 TO LEN(F$):N=ASC(MID$(F$,X,1))
  345. 9216 IF N<48 OR N>122 THEN GOTO 9250
  346. 9218 IF (N>57 AND N<65) OR (N>90 AND N<97) THEN GOTO 9250
  347. 9219 NEXT X:IF T$="ASCI" OR T$="MERG" OR T$="TOKEN" THEN RETURN
  348. 9220 LET FI$=F$+"        "
  349. 9221 FOR X=1 TO 8:POKE 44+X,ASC(MID$(FI$,X,1)):NEXT X:POKE 53,70:POKE 54,68:POKE 55,88:POKE 44,DR
  350. 9225 IF F$="NoName" OR T$="LOAD" OR T$="TOKEN" OR T$="RST" OR T$="RENM" OR T$="ASCI" THEN RETURN
  351. 9230 GOSUB 7107:IF K$="DISK" THEN X$=K$:GOTO 9000:ELSE GOTO 7450
  352. 9250 LOCATE 22,1,1:PRINT F$;" is invalid. Please redo...":SWAP F$,G$:GOTO 9212
  353. 9300 '  *** Save Routine ***
  354. 9310 DEF SEG=DS:POKE 0,FNB(P(1)):POKE 1,FNC(P(1)):POKE 2,FNB(P(2)):POKE 3,FNC(P(2)):FOR X=4 TO 11:POKE X,ASC(MID$(FI$,X-3,1)):NEXT X:DEF SEG=MC:POKE 44,1
  355. 9315 IF HARD AND ENGAGED THEN POKE 44,3
  356. 9330 ON ERROR GOTO 9395:POKE F,8:CALL G:ON ERROR GOTO 0:IF PEEK(&H2A)<>0 THEN GOTO 9350
  357. 9340 G$=X$:GOSUB 10100:X$=G$:GOTO 9230
  358. 9350 IF PEEK(&H2A)<>0 AND PEEK(44)=1 THEN KILL "A:"+F$+".fdx":POKE 44,2:GOTO 9330
  359. 9380 GOSUB 7107:IF PEEK(&H2A)=1 THEN PRINT"Not enough room on disk.":KILL "B:"+F$+".FDX"
  360. 9390 PRINT "Warning! Disk Write Error... Save data again on another disk.":PRINT "Press any key to resume Main Menu":WHILE INKEY$="":WEND:Y$="N":X$="*":K$="x":GOTO 9340
  361. 9395 GOSUB 7107:PRINT "Disk not ready. Insert Disk, close door, press any key...":WHILE INKEY$="":WEND:RESUME 9330
  362. 9400 '   *** Load Routine ***
  363. 9405 DR=1:Q$=F$:GOSUB 9212:IF G$="" THEN 9230
  364. 9410 SWAP F$,G$:IF HARD AND ENGAGED THEN DR=3:POKE 44,DR
  365. 9420 ON ERROR GOTO 9490:POKE F,9:CALL G:ON ERROR GOTO 0
  366. 9435 IF PEEK(&H2A)<>0 AND DR=1 THEN DR=2:GOSUB 9221:GOTO 9420
  367. 9440 IF PEEK(&H2A)<>0 AND (DR=2 OR DR=3) THEN DR=1:LOCATE 22,1,0:PRINT "File not found.":F$=Q$:GOSUB 9220:GOTO 9405
  368. 9450 F$="":DEF SEG=DS:LET P(1)=FNA(0):P(2)=FNA(2):FOR X=1 TO 8:LET F$=F$+CHR$(PEEK(3+X)):IF PEEK(3+X)<>32 THEN NEXT X:F$=F$+" "
  369. 9460 F$=LEFT$(F$,LEN(F$)-1):DEF SEG=MC:GOSUB 9220
  370. 9470 GOSUB 10100:GOSUB 10120:GOSUB 11000:GOTO 9230
  371. 9490 GOSUB 7107:PRINT "Disk not ready. Insert Disk, close door, press any key...":WHILE INKEY$="":WEND:RESUME 9420
  372. 9500 '
  373. 9510 CLS:GOSUB 20200:PRINT "Disk Directory...   .FDX files are accessed with SAVE/LOAD commands  .TXT files are accessed with WRITE and MERGE    .TKN files are accessed with TLOD"
  374. 9515 ON ERROR GOTO 9599
  375. 9516 IF HARD AND ENGAGED THEN GOTO 9525
  376. 9520 FILES "A:*.FDX":FILES "B:*.FDX":FILES "A:*.TXT":FILES "B:*.TXT":FILES "A:*.TKN":FILES "B:*.TKN
  377. 9524 ON ERROR GOTO 0:GOTO 9530
  378. 9525 FILES "C:*.FDX":FILES "C:*.TXT":FILES "C:*.TKN":GOTO 9524
  379. 9530 LOCATE 22,1:PRINT"Current File:";F$,"Current ASCII Output File:";FX$:PRINT "Options: SAVE/LOAD/MERG/TLOD/NNAM/ASCI/DELE/RENM/HARD or <ENTER> for Main Menu":K$="DISK":INPUT;X$:GOSUB 9585:X$=T$:POKE 105,20:GOSUB 7110
  380. 9539 IF X$="NNAM" OR X$="SAVE" OR X$="LOAD" OR X$="MERG" OR X$="ASCI" OR X$="TLOD" OR X$="HARD" THEN RETURN
  381. 9540 IF X$="" THEN K$=X$:RETURN 100
  382. 9542 IF X$="DELE" OR X$="RENM" THEN GOSUB 7107:PRINT"Enter FILENAME to ";X$;" using standard XXXXXXXX.YYY format":INPUT Q$:IF Q$="" THEN 9550:ELSE 9560
  383. 9550 GOTO 9530
  384. 9560 IF X$="DELE" THEN 9610:ELSE INPUT"Now enter NEW name:";T$:GOTO 9600
  385. 9585 T$=X$:FOR X=1 TO LEN(X$):N=ASC(MID$(X$,X,1)) AND 223:MID$(T$,X,1)=CHR$(N):NEXT:RETURN
  386. 9590 IF X$="A:" AND ERR=53 THEN X$="B:":RESUME 9605
  387. 9591 LOCATE 21,1:PRINT"Can't rename (";Q$;") as (";T$;") because ";
  388. 9592 IF ERR=58 THEN PRINT T$;" already exists."
  389. 9593 IF ERR=55 THEN PRINT T$;" is currently in use."
  390. 9594 IF X$="B:" AND ERR=53 THEN PRINT Q$;" is not on disk."
  391. 9595 RESUME 9524
  392. 9599 RESUME NEXT
  393. 9600 GOSUB 7107:X$="A:":IF HARD AND ENGAGED THEN X$="C:"
  394. 9605 ON ERROR GOTO 9590:NAME X$+Q$ AS X$+T$:ON ERROR GOTO 0:GOTO 9500
  395. 9610 IF Q$=FX$+".TXT" OR Q$=FX$+".txt" THEN CLOSE:FX$=""
  396. 9615 IF HARD AND ENGAGED THEN ON ERROR GOTO 9599:KILL "C:"+Q$:ON ERROR GOTO 0:GOTO 9500
  397. 9618 ON ERROR GOTO 9599:KILL "A:"+Q$:KILL "B:"+Q$:ON ERROR GOTO 0
  398. 9620 GOTO 9500
  399. 9700 GOSUB 11000:G$=L$:LINE INPUT "Enter line number you wish to sort by:";L$:IF RIGHT$(L$,1)="-" THEN X=114:L$=LEFT$(L$,LEN(L$)-1):SD$="-":GOTO 9710:ELSE X=119:SD$="+"
  400. 9710 GOSUB 7600:IF Z THEN POKE 1594,X:S=VAL(L$):POKE &H53,S:POKE F,7:CALL G:POKE F,11:PRINT"Sorting...":CALL G:L$=G$:Z=0:P(1)=FNA(92):P(2)=FNA(88):GOTO 100:ELSE L$=G$:GOTO 9000
  401. 9900 IF Y$=X$ THEN LET X$=TEMP$:Y$="M":GOSUB 7100:GOTO 505
  402. 9902 LOCATE 8,1:FOR X=1 TO 7:PRINT STRING$(28,32):NEXT X:LOCATE 8,1
  403. 9905 IF M=2 THEN M=0:GOTO 130:ELSE IF M=1 THEN 9930
  404. 9910 PRINT "MERG  to Merge Data":PRINT"CHAT  Change Tally Line":PRINT"BAUD  Set Ser. Baud Rate":PRINT"ASCI  Name ASCII Output File":PRINT"DISK  Disk Utilities":PRINT"SDAT  Set Date":PRINT"SERI  Merge Serial Records"
  405. 9920 M=1:GOTO 160
  406. 9930 PRINT "SAVE to Save File":PRINT "LOAD to Load File":PRINT "EXIT Returns to DOS":PRINT "FORM to Print Form Letters":PRINT "HARD Select HARD/FLOPPY Disk"
  407. 9940 M=2:GOTO 160
  408. 9999 END
  409. 10000 SCREEN 0,0:KEY OFF:DEF FNA(W)=PEEK(W)+256*PEEK(W+1):COLOR 7,0
  410. 10005 DEF FNB(W)=W-256*INT(W/256):DEF FNC(W)=INT(W/256):WIDTH "LPT1:",255
  411. 10010 K$=" ":DEFINT X,Y,Z:F$="NoName":OPTION BASE 1:DIM PAST$(20),PCD(18),PST(20,2)
  412. 10015 RESTORE 49995:FOR X=1 TO 7:READ TOK$(X),NUM(X):NEXT X
  413. 10020 FOR X=1 TO 10:KEY X,CHR$(14+X)+STRING$(7,0):NEXT X:R=1200:RATE=3
  414. 10025 G=150:F=37:TKN$="NoName":T=1
  415. 10030 DS=MC+256:DS2=DS+4096:DIM FOP$(12)
  416. 10035 CLS:GOSUB 10080:DIM E$(19):DEF SEG=MC:BLOAD "FX3-4",0:GOSUB 10130:IF HARD THEN ENGAGED=1:ELSE ENGAGED=0
  417. 10036 DIM KV(128):KV(83)=127:KV(71)=12:KV(72)=30:KV(75)=28:KV(77)=29:KV(80)=31
  418. 10040 LET P(1)=20:LET P(2)=20:GOSUB 10120:GOSUB 10100
  419. 10045 GOSUB 11000:GOSUB 9220:IF T$="RST" THEN RETURN
  420. 10050 ON ERROR GOTO 10110
  421. 10055 OPEN "I",#1,"FORMAT.BAS":ON ERROR GOTO 0
  422. 10060 FOR X=1 TO 12:LINE INPUT #1,FOP$(X):NEXT X:CLOSE #1
  423. 10065 L$=LEFT$(FOP$(1),10):LX$=RIGHT$(FOP$(1),LEN(FOP$(1))-10):GOTO 100
  424. 10080 LOCATE 8,29,0:PRINT"FINDEX by Thomas B. Woods"
  425. 10082 LOCATE 10,36:PRINT "(c) 1986"
  426. 10083 LOCATE 15,34:PRINT "Published by"
  427. 10084 LOCATE 17,30:PRINT "E. Arthur Brown Company"
  428. 10085 LOCATE 18,22:PRINT "3404 Pawnee Drive, Alexandria, MN 56308"
  429. 10086 LOCATE 19,33:PRINT "(612) 762-8847"
  430. 10087 PRINT:PRINT"This shareware copy comes to you compliments of:":GOSUB 62100:PRINT "Press any key to begin...":WHILE INKEY$="":WEND
  431. 10100 X$="SEARCH IS COMPLETE":FOR X=1 TO 18:Y=ASC(MID$(X$,X,1)):DEF SEG=DS:POKE X,Y:DEF SEG=DS2:POKE X,Y:NEXT X:POKE 0,1:POKE 19,1:DEF SEG=DS:POKE 0,1:POKE 19,1:DEF SEG=MC:RETURN
  432. 10110 OPEN "O",#1,"FORMAT.BAS":X$="":FOR X=1 TO 19:X$=X$+CHR$(128+X):NEXT X:PRINT#1,"ALL LINES "+X$:FOR X=2 TO 12:PRINT#1,"Not Used  ":NEXT X:CLOSE#1:RESUME
  433. 10111 '
  434. 10120 GOSUB 11050:FOR X=86 TO 89:POKE X,PEEK(X-86):NEXT X:GOSUB 11000:FOR X=90 TO 93:POKE X,PEEK(X-90):NEXT X:RETURN
  435. 10130 ' *** Test for Hard Disk ***
  436. 10135 ON ERROR GOTO 10150:OPEN "I",#1,"C:test.bin":CLOSE#1
  437. 10136 HARD=1
  438. 10137 ON ERROR GOTO 0:RETURN
  439. 10140 HARD=0:GOTO 10137
  440. 10150 IF ERR=76 THEN RESUME 10140:ELSE RESUME 10136
  441. 11000 POKE 0,FNB(DS):POKE 1,FNC(DS):POKE 2,FNB(P(1)):POKE 3,FNC(P(1)):LET DBLK=1:POKE 4,0:POKE 5,0:POKE 81,0:POKE 82,0:POKE 110,0:RETURN
  442. 11050 POKE 0,FNB(DS2):POKE 1,FNC(DS2):POKE 2,FNB(P(2)):POKE 3,FNC(P(2)):LET DBLK=2:RETURN
  443. 20000 RETURN
  444. 20100 LOCATE 7,40,0:PRINT "        * * * STATUS WINDOW * * *        "
  445. 20105 POKE F,7:CALL G:GOSUB 9110:PRINT "Filename:";F$;"   ";DATE$:LOCATE 10,41:PRINT"Space Open:";131070!-(P(1)+P(2));TAB(60);"Records:";:GOSUB 60000
  446. 20107 LOCATE 11,41:PRINT "Tally Line:";T,"Tokens:";TKN$:LOCATE 12,41:PRINT"Order Line:";S;SD$,"Baud:";R:LOCATE 13,41:PRINT"Output Format:";L$:LOCATE 14,41:PRINT"ASCII Output Name:";FX$
  447. 20110 LOCATE 15,41:IF HARD AND ENGAGED THEN PRINT "Hard Disk ENGAGED":ELSE IF HARD AND NOT ENGAGED THEN PRINT "Hard Disk DISENGAGED"
  448. 20120 COLOR 7,0:RETURN
  449. 20130 '
  450. 20140 IF I(1) THEN IN$(1)="insert":IN$(2)="OVER":ELSE IN$(1)="INSERT":IN$(2)="over"
  451. 20145 GOSUB 7107:LOCATE 20,1,0:PRINT STRING$(80,"═");"  F1 Alternate ";:COLOR I(1),I(2):PRINT IN$(1);:COLOR 7,0:PRINT"/";:COLOR I(2),I(1):PRINT IN$(2);:COLOR 7,0:PRINT "  ";
  452. 20150 PRINT"  F4 Line Delete","  F7 Line Erase","  F2 Line Insert","  F5 Close Record","  F8 Next Record";"  F3 Lprint Record","  F6 Status Display","  F9 More...":RETURN
  453. 20170 Y=1:PRINT "ESC  Escape ADD/EDIT mode       F10 Print Date      F9 MORE    CTRL/Z Swap":FOR X=1 TO 7:PRINT TAB(Y);CHR$(64+X);":";LEFT$(M$(X),10);:Y=Y+17
  454. 20180 IF Y>68 THEN PRINT:Y=1
  455. 20190 NEXT X:PRINT TAB(Y);"CTRL Keys (A-G) Print Tokens":RETURN
  456. 20200 CLS
  457. 20201 PRINT STRING$(80,205);SPC(15);"FINDEX INFORMATION STORAGE AND RETRIEVAL SYSTEM":PRINT STRING$(80,205);:RETURN
  458. 49995 DATA " and ",255," AND ",255," or ",253," OR ",253," not ",254," NOT ",254,"*",1
  459. 60000 POKE F,10:CALL G:PRINT FNA(81):RETURN
  460. 62000 ' *** Subroutine to determine segments for machine code and data ***
  461. 62005 LET MCD$=CHR$(&H2E)+CHR$(&H8C)+CHR$(&HE)+CHR$(&H0)+CHR$(&H0)+CHR$(&HCB)+CHR$(&H0)+CHR$(&H0)
  462. 62010 DEF SEG:LET V=VARPTR(MCD$):V1=PEEK(V+1)+256*PEEK(V+2):POKE V1+3,(V1+6)-256*INT((V1+6)/256):POKE V1+4,INT((V1+6)/256)
  463. 62020 CALL V1:LET BAS=(PEEK(V1+6)+256*PEEK(V1+7)):MC=4097+BAS:RETURN
  464. 62100 PRINT "TOM WOODS     Serial #870420010400":RETURN
  465.